home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
DB_CLIPP
/
0292.ZIP
/
DOP.ARC
/
DOP3.PRG
< prev
Wrap
Text File
|
1984-12-30
|
10KB
|
341 lines
********** DOP3.PRG VERSION 2.3 DBASE III VERSION **************
** BY GARY C. AREY 1030 HOLLAND DR. GARLAND, TX. 75040 7/26/84 **
SET TALK OFF
SET DEVICE TO SCREEN
CLEAR ALL
CLEAR
? 'The following .DBF files are on the default drive :'
?
LIST FILES LIKE *.DBF
?
ACCEPT 'WHAT DATABASE DO YOU WISH TO USE : ' TO BB
DO WHILE .T.
CLEAR
@ 01,27 SAY 'DBASE III OPERATIONS MENU'
@ 02,27 SAY '========================='
@ 04,17 SAY 'The Current .DBF File Now In Use is :'
@ 04,56 SAY '&BB' PICTURE "!!!!!!!!!!!!"
@ 08,11 SAY ' 1> List <C> Create .DBF'
@ 09,11 SAY ' 2> Browse <S> Sort File'
@ 10,11 SAY ' 3> Edit Record <E> Erase File '
@ 11,11 SAY ' 4> Search Character Field <L> DIR Files on Drive'
@ 12,11 SAY ' 5> Search Numeric Field <R> Create/Modify Report'
@ 13,11 SAY ' 6> Append (Add Records) <N> Change Database'
@ 14,11 SAY ' 7> Mark to Delete <D> Delete (Pack)'
@ 15,11 SAY ' 8> Report to Screen <P> Report Print '
@ 16,11 SAY ' 9> View Structure <F> View Files '
@ 17,11 SAY ' X> Exit To DBASE . Prompt <Q> Quit to DOS '
SET CONSOLE OFF
WAIT TO Action
SET CONSOLE ON
IF UPPER(Action)= '1'
CLEAR
USE &BB
INPUT 'BEGINNING RECORD NO. : ' TO Q
?
ACCEPT 'Do you want to PRINT the result? (Y)es (N)o : ' to PR
IF UPPER(PR) = 'Y'
SET PRINT ON
ENDIF
RELEASE PR
GOTO Q
CLEAR
LIST FOR RECNO() >= Q
?
SET PRINT OFF
WAIT
USE
ELSE
IF UPPER(Action)= '2'
CLEAR
USE &BB
? 'While BROWSING you may Return to enter and move through record.'
? 'Control B moves screen right one field. '
? 'Control Z moves screen left one field. '
? 'Control U marks a record for deletion. '
? 'PgUp and PgDn moves edit line up and down one record.'
? 'Control Q quits without saving changes. '
? 'Control W saves changes and quits. '
?
INPUT 'BEGINNING RECORD NO. : ' TO Q
GOTO Q
BROWSE
USE
ELSE
IF UPPER(Action)= '3'
CLEAR
USE &BB
? 'While EDITING you may Return to enter record and complete Edit.'
? 'Control Q quits without saving changes.'
? 'Control W saves changes and quits.'
?
INPUT 'BEGINNING RECORD NO. : 'TO Q
GOTO Q
EDIT
USE
ELSE
IF UPPER(Action)= '4'
CLEAR
ACCEPT ' Do you wish to SEARCH on (1) or (2) fields? ' to QR
IF UPPER(QR)='1'
CLEAR
USE &BB
LIST STRUCTURE
?
ACCEPT 'SEARCH FIELD : ' TO SF
ACCEPT 'SEARCH FOR : ' TO CN
?
ACCEPT 'Do you want to PRINT the result? (Y)es (N)o : ' to PR
IF UPPER(PR)='Y'
SET PRINT ON
ENDIF
RELEASE PR
CLEAR
LIST FOR UPPER('&CN')$&SF
SET PRINT OFF
?
USE
WAIT
ENDIF
IF UPPER(QR)='2'
CLEAR
USE &BB
LIST STRUCTURE
?
ACCEPT 'Enter Search Field 1 : ' to SF
ACCEPT 'Search for ' to CN
ACCEPT 'Enter Search Field 2 : ' to SF2
ACCEPT 'Search for ' to CN2
?
ACCEPT 'Do you want to PRINT the result? (Y)es (N)o : ' to PR
IF UPPER(PR)='Y'
SET PRINT ON
ENDIF
RELEASE PR
CLEAR
LIST FOR UPPER('&CN')$&SF .AND. UPPER('&CN2')$&SF2
SET PRINT OFF
?
USE
WAIT
ENDIF
ELSE
IF UPPER(Action)= '5'
CLEAR
USE &BB
LIST STRUCTURE
?
ACCEPT 'NUMERIC SEARCH FIELD : ' TO NF
INPUT 'NUMERIC AMOUNT : ' TO NN
ACCEPT '< = > : ' TO E
?
ACCEPT 'Do you want to PRINT the result? (Y)es (N)o : ' to PR
IF UPPER(PR)='Y'
SET PRINT ON
ENDIF
RELEASE PR
CLEAR
LIST FOR &NF &E NN
SET PRINT OFF
?
WAIT
USE
ELSE
IF UPPER(Action)= '6'
CLEAR
USE &BB
? 'In APPEND mode Control W quits and saves new records to disk.'
? ' Control Q quits without saving new records.'
?
WAIT
APPEND
USE
ELSE
IF UPPER(Action)= '7'
CLEAR
USE &BB
ACCEPT 'RECORD NO. TO BE MARKED FOR DELETION : ' TO RD
DELETE RECORD &RD
? 'SELECTED RECORD WAS MARKED FOR DELETION !'
WAIT
CLEAR
USE
ELSE
IF UPPER(ACTION)='C'
CLEAR
? 'The following .DBF files already exist on the default drive :'
LIST FILES LIKE *.DBF
?
CREATE
CLEAR
ELSE
IF UPPER(Action)= 'N'
CLEAR
RELEASE ALL
? 'The following .DBF files are on the default drive :'
?
LIST FILES LIKE *.DBF
?
ACCEPT 'ENTER NAME OF NEW DATABASE YOU WISH TO USE : ' TO BB
ELSE
IF UPPER(Action)= 'D'
CLEAR
USE &BB
PACK
? 'PACK AND DELETION COMPLETED !'
USE
ELSE
IF UPPER(Action)= 'R'
CLEAR
USE &BB
? 'The following .FRM Report Forms are on the default drive :'
?
LIST FILES LIKE *.FRM
?
MODIFY REPORT
USE
ELSE
IF UPPER(Action)= '8'
CLEAR
USE &BB
? 'The following .FRM Report Forms are on the default drive :'
?
LIST FILES LIKE *.FRM
?
REPORT
WAIT
USE
ELSE
IF UPPER(Action)= 'P'
CLEAR
USE &BB
INPUT 'ENTER NUMBER OF COPIES TO PRINT : ' TO MNO
? 'The following .FRM Report Forms are on the default drive :'
?
LIST FILES LIKE *.FRM
?
ACCEPT ' NAME OF REPORT YOU WISH TO PRINT : ' TO RF
CLEAR
DO WHILE .NOT. EOF()
DO WHILE MNO > 0
STORE MNO-1 TO MNO
REPORT FORM &RF TO PRINT
ENDDO
ENDDO
WAIT
USE
ELSE
IF UPPER(Action)= '9'
CLEAR
USE &BB
LIST STRUCTURE
WAIT
USE
ELSE
IF UPPER(Action)='S'
CLEAR
USE &BB
LIST STRUCTURE
?
ACCEPT 'Do you wish to SORT on (1) or (2) fields? : 'to NB
IF UPPER(NB)='1'
ACCEPT 'Enter Field Name to SORT on : ' to FT
?
? 'SORTING IN PROGRESS !'
SORT TO TEMP ON &FT/A
USE TEMP
COPY TO &BB
USE &BB
ERASE TEMP.DBF
ERASE TEMP.DBT
USE
ENDIF
IF UPPER(NB)='2'
ACCEPT 'Enter Sort Field 1 : 'to FT
ACCEPT 'Enter Sort Field 2 : 'to FQ
?
? 'SORTING IN PROGRESS !'
USE &BB
SORT TO TEMP ON &FT/A,&FQ/A
USE TEMP
COPY TO &BB
USE &BB
ERASE TEMP.DBF
ERASE TEMP.DBT
ENDIF
USE
ELSE
IF UPPER(Action)='E'
CLEAR
? 'Enter (0) if you do NOT wish to Erase a File.'
?
ACCEPT 'Enter File Name you wish to ERASE ! : ' to ERS
ERASE &ERS
RELEASE ERS
ELSE
IF UPPER(Action)='L'
CLEAR
ACCEPT 'Enter Drive Letter (Ex. B C) for DIR : ' to DR
ACCEPT 'Enter Filespec *.* for all or directory path : 'to SPC
DIR &DR:&SPC
WAIT
ELSE
IF UPPER(Action)= 'F'
CLEAR
? 'ENTER FILE SPEC to VIEW FILES on Default Drive ;'
?
? ' DBF for Database Files'
? ' FRM for Report Form Files'
? ' PRG for Command Program Files'
? ' DBT for Memo Fields Files'
? ' LBL for Label Form Files'
? ' FMT for Format Files'
? ' NDX for Index Files'
? ' MEM for Memory Files'
? ' TXT for Text Files'
?
ACCEPT 'ENTER FILE SPEC : ' TO FS
?
LIST FILES LIKE *.&FS
?
WAIT
ELSE
IF UPPER(Action)='Q'
USE
CLEAR
CLEAR ALL
QUIT
ELSE
IF UPPER(Action)= 'X'
CLEAR ALL
RETURN
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDDO
RELEASE T, ACTION
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDDO